home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ADA Programming Guide
/
ADA Programming Guide.iso
/
ada_pcdp
/
ada
/
sem.ada
< prev
next >
Wrap
Text File
|
1996-01-30
|
2KB
|
101 lines
package Semaphore_Package is
type Semaphore is private;
type Binary_Semaphore is private;
function Init(N: Integer) return Semaphore;
procedure Wait (S: Semaphore);
procedure Signal(S: Semaphore);
function Init(N: Integer) return Binary_Semaphore;
procedure Wait (S: Binary_Semaphore);
procedure Signal(S: Binary_Semaphore);
Bad_Semaphore_Initialization: exception;
private
task type Semaphore_Task is
entry Init(N: Integer; B: Boolean);
entry Wait;
entry Signal;
end Semaphore_Task;
type Semaphore is access Semaphore_Task;
type Binary_Semaphore is access Semaphore_Task;
end Semaphore_Package;
package body Semaphore_Package is
task body Semaphore_Task is
Binary: Boolean;
V: Integer;
begin
accept Init(N: Integer; B: Boolean) do
Binary := B;
V := N;
end Init;
loop
select
accept Wait do
if V > 0 then V := V - 1;
else accept Signal;
end if;
end Wait;
or
accept Signal do
if not Binary or else V = 0 then
V := V + 1;
end if;
end Signal;
or
terminate;
end select;
end loop;
end Semaphore_Task;
function Init(N: Integer) return Semaphore is
S: Semaphore;
begin
if N < 0 then raise Bad_Semaphore_Initialization;
else
S := new Semaphore_Task;
S.Init(N, False);
return S;
end if;
end Init;
function Init(N: Integer) return Binary_Semaphore is
S: Binary_Semaphore;
begin
if (N < 0) or (N > 1) then raise Bad_Semaphore_Initialization;
else
S := new Semaphore_Task;
S.Init(N, True);
return S;
end if;
end Init;
procedure Wait(S: Semaphore) is
begin
S.Wait;
end Wait;
procedure Signal(S: Semaphore) is
begin
S.Signal;
end Signal;
procedure Wait(S: Binary_Semaphore) is
begin
S.Wait;
end Wait;
procedure Signal(S: Binary_Semaphore) is
begin
S.Signal;
end Signal;
end Semaphore_Package;